home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / numerical / slatec / d9b0mp.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  14.3 KB  |  218 lines
  1. ;;; Compiled by f2cl version 2.0 beta 2002-05-06
  2. ;;; 
  3. ;;; Options: ((:prune-labels nil) (:auto-save t) (:relaxed-array-decls t)
  4. ;;;           (:coerce-assigns :as-needed) (:array-type ':simple-array)
  5. ;;;           (:array-slicing nil) (:declare-common nil)
  6. ;;;           (:float-format double-float))
  7.  
  8. (in-package "SLATEC")
  9.  
  10.  
  11. (let ((nbm0 0)
  12.       (nbt02 0)
  13.       (nbm02 0)
  14.       (nbth0 0)
  15.       (xmax 0.0)
  16.       (bm0cs (make-array 37 :element-type 'double-float))
  17.       (bth0cs (make-array 44 :element-type 'double-float))
  18.       (bm02cs (make-array 40 :element-type 'double-float))
  19.       (bt02cs (make-array 39 :element-type 'double-float))
  20.       (pi4 0.7853981633974483)
  21.       (first nil))
  22.   (declare (type f2cl-lib:logical first)
  23.            (type (simple-array double-float (39)) bt02cs)
  24.            (type (simple-array double-float (40)) bm02cs)
  25.            (type (simple-array double-float (44)) bth0cs)
  26.            (type (simple-array double-float (37)) bm0cs)
  27.            (type double-float pi4 xmax)
  28.            (type f2cl-lib:integer4 nbth0 nbm02 nbt02 nbm0))
  29.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (1) ((1 37))) 0.09211656246827743)
  30.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (2) ((1 37))) -0.0010505909972719051)
  31.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (3) ((1 37))) 1.4701598407687597e-5)
  32.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (4) ((1 37))) -5.058557606038554e-7)
  33.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (5) ((1 37))) 2.7872545386324443e-8)
  34.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (6) ((1 37))) -2.062363611780915e-9)
  35.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (7) ((1 37))) 1.87021431313888e-10)
  36.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (8) ((1 37))) -1.9693309711356366e-11)
  37.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (9) ((1 37))) 2.3259737939992753e-12)
  38.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (10) ((1 37))) -3.0095203449382507e-13)
  39.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (11) ((1 37))) 4.194521333850669e-14)
  40.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (12) ((1 37))) -6.219449312188445e-15)
  41.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (13) ((1 37))) 9.718260411336069e-16)
  42.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (14) ((1 37))) -1.5884785857010755e-16)
  43.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (15) ((1 37))) 2.700072193671309e-17)
  44.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (16) ((1 37))) -4.7500923652340094e-18)
  45.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (17) ((1 37))) 8.615128162604372e-19)
  46.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (18) ((1 37))) -1.6056086869561448e-19)
  47.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (19) ((1 37))) 3.066513987314483e-20)
  48.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (20) ((1 37))) -5.987764223193957e-21)
  49.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (21) ((1 37))) 1.1929712537482481e-21)
  50.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (22) ((1 37))) -2.4209691420448054e-22)
  51.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (23) ((1 37))) 4.996751760510617e-23)
  52.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (24) ((1 37))) -1.0474936393511587e-23)
  53.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (25) ((1 37))) 2.2277868437974682e-24)
  54.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (26) ((1 37))) -4.8018132393981616e-25)
  55.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (27) ((1 37))) 1.0479627234709601e-25)
  56.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (28) ((1 37))) -2.3138581656786159e-26)
  57.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (29) ((1 37))) 5.164823088462674e-27)
  58.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (30) ((1 37))) -1.1646911918500655e-27)
  59.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (31) ((1 37))) 2.65178848604332e-28)
  60.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (32) ((1 37))) -6.092559503825729e-29)
  61.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (33) ((1 37))) 1.4118046861442593e-29)
  62.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (34) ((1 37))) -3.298094961231737e-30)
  63.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (35) ((1 37))) 7.763931143074065e-31)
  64.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (36) ((1 37))) -1.8410313436614584e-31)
  65.   (f2cl-lib:fset (f2cl-lib:fref bm0cs (37) ((1 37))) 4.3958801385943114e-32)
  66.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (1) ((1 44))) -0.24901780862128936)
  67.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (2) ((1 44))) 4.855029960962375e-4)
  68.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (3) ((1 44))) -5.45118373450172e-6)
  69.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (4) ((1 44))) 1.3558673059405965e-7)
  70.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (5) ((1 44))) -5.569139890222763e-9)
  71.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (6) ((1 44))) 3.260903182499434e-10)
  72.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (7) ((1 44))) -2.4918807862461345e-11)
  73.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (8) ((1 44))) 2.344937742088252e-12)
  74.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (9) ((1 44))) -2.609653444431039e-13)
  75.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (10) ((1 44))) 3.3353140420097394e-14)
  76.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (11) ((1 44))) -4.789000044057268e-15)
  77.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (12) ((1 44))) 7.595617843619222e-16)
  78.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (13) ((1 44))) -1.313155601689144e-16)
  79.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (14) ((1 44))) 2.4483618345240857e-17)
  80.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (15) ((1 44))) -4.880572981061878e-18)
  81.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (16) ((1 44))) 1.0327285029786318e-18)
  82.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (17) ((1 44))) -2.305763381505722e-19)
  83.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (18) ((1 44))) 5.404444300189268e-20)
  84.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (19) ((1 44))) -1.3240695194366572e-20)
  85.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (20) ((1 44))) 3.3780795621371973e-21)
  86.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (21) ((1 44))) -8.94576291571118e-22)
  87.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (22) ((1 44))) 2.4519906889219317e-22)
  88.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (23) ((1 44))) -6.938842287686633e-23)
  89.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (24) ((1 44))) 2.0228278714890138e-23)
  90.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (25) ((1 44))) -6.062850000233548e-24)
  91.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (26) ((1 44))) 1.8649748964037632e-24)
  92.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (27) ((1 44))) -5.878373238484988e-25)
  93.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (28) ((1 44))) 1.895859144799956e-25)
  94.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (29) ((1 44))) -6.248197937225886e-26)
  95.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (30) ((1 44))) 2.101790168455103e-26)
  96.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (31) ((1 44))) -7.208430093520926e-27)
  97.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (32) ((1 44))) 2.5181363892474246e-27)
  98.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (33) ((1 44))) -8.951804225878578e-28)
  99.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (34) ((1 44))) 3.2357237479762296e-28)
  100.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (35) ((1 44))) -1.1883010519855355e-28)
  101.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (36) ((1 44))) 4.43062869073581e-29)
  102.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (37) ((1 44))) -1.676100964883483e-29)
  103.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (38) ((1 44))) 6.429294692120746e-30)
  104.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (39) ((1 44))) -2.499226116697865e-30)
  105.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (40) ((1 44))) 9.839979429952197e-31)
  106.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (41) ((1 44))) -3.922037524240802e-31)
  107.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (42) ((1 44))) 1.5818107030056522e-31)
  108.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (43) ((1 44))) -6.452550614489073e-32)
  109.   (f2cl-lib:fset (f2cl-lib:fref bth0cs (44) ((1 44))) 2.6611111369199364e-32)
  110.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (1) ((1 40))) 0.09500415145228382)
  111.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (2) ((1 40))) -3.801864682365671e-4)
  112.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (3) ((1 40))) 2.2583393010314814e-6)
  113.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (4) ((1 40))) -3.895725802372228e-8)
  114.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (5) ((1 40))) 1.2468864165120816e-9)
  115.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (6) ((1 40))) -6.065949022102504e-11)
  116.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (7) ((1 40))) 4.0084616514217464e-12)
  117.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (8) ((1 40))) -3.350998183398094e-13)
  118.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (9) ((1 40))) 3.377119716517417e-14)
  119.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (10) ((1 40))) -3.9645859016350127e-15)
  120.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (11) ((1 40))) 5.286111503883857e-16)
  121.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (12) ((1 40))) -7.852519083450852e-17)
  122.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (13) ((1 40))) 1.280300573386682e-17)
  123.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (14) ((1 40))) -2.2639962963914298e-18)
  124.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (15) ((1 40))) 4.30049692965679e-19)
  125.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (16) ((1 40))) -8.705749805132588e-20)
  126.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (17) ((1 40))) 1.8658627139620948e-20)
  127.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (18) ((1 40))) -4.2104824860930656e-21)
  128.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (19) ((1 40))) 9.956676964228401e-22)
  129.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (20) ((1 40))) -2.4573574428053133e-22)
  130.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (21) ((1 40))) 6.307692160762031e-23)
  131.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (22) ((1 40))) -1.6787736914407403e-23)
  132.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (23) ((1 40))) 4.6202590646739045e-24)
  133.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (24) ((1 40))) -1.3117822668603088e-24)
  134.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (25) ((1 40))) 3.8340875641163025e-25)
  135.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (26) ((1 40))) -1.1514593240777413e-25)
  136.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (27) ((1 40))) 3.5472100075233387e-26)
  137.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (28) ((1 40))) -1.1192183858150047e-26)
  138.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (29) ((1 40))) 3.611879427629838e-27)
  139.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (30) ((1 40))) -1.1906877659133333e-27)
  140.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (31) ((1 40))) 4.0050940594039686e-28)
  141.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (32) ((1 40))) -1.3731694224522123e-28)
  142.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (33) ((1 40))) 4.794199088742532e-29)
  143.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (34) ((1 40))) -1.7029656276241095e-29)
  144.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (35) ((1 40))) 6.14951242893633e-30)
  145.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (36) ((1 40))) -2.2557668965818284e-30)
  146.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (37) ((1 40))) 8.3997075092943e-31)
  147.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (38) ((1 40))) -3.1729975955626016e-31)
  148.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (39) ((1 40))) 1.2152052988812986e-31)
  149.   (f2cl-lib:fset (f2cl-lib:fref bm02cs (40) ((1 40))) -4.7158527497544395e-32)
  150.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (1) ((1 39))) -0.24548295213424598)
  151.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (2) ((1 39))) 0.0012544121039084616)
  152.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (3) ((1 39))) -3.1253950414871523e-5)
  153.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (4) ((1 39))) 1.470977824994083e-6)
  154.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (5) ((1 39))) -9.954348893795003e-8)
  155.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (6) ((1 39))) 8.549316673320305e-9)
  156.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (7) ((1 39))) -8.698975952655433e-10)
  157.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (8) ((1 39))) 1.0052099533559791e-10)
  158.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (9) ((1 39))) -1.2828230601708893e-11)
  159.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (10) ((1 39))) 1.7731700781805132e-12)
  160.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (11) ((1 39))) -2.6174574569485576e-13)
  161.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (12) ((1 39))) 4.082835138997206e-14)
  162.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (13) ((1 39))) -6.675166823974272e-15)
  163.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (14) ((1 39))) 1.136576139307163e-15)
  164.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (15) ((1 39))) -2.0051189620647164e-16)
  165.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (16) ((1 39))) 3.6497978794766267e-17)
  166.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (17) ((1 39))) -6.83096375645823e-18)
  167.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (18) ((1 39))) 1.310758314567076e-18)
  168.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (19) ((1 39))) -2.572336310185061e-19)
  169.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (20) ((1 39))) 5.152165744186394e-20)
  170.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (21) ((1 39))) -1.0513017563758804e-20)
  171.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (22) ((1 39))) 2.1820381991194815e-21)
  172.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (23) ((1 39))) -4.6004701210362153e-22)
  173.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (24) ((1 39))) 9.840700692546682e-23)
  174.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (25) ((1 39))) -2.1334038035728375e-23)
  175.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (26) ((1 39))) 4.6831036423973366e-24)
  176.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (27) ((1 39))) -1.0400213691985746e-24)
  177.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (28) ((1 39))) 2.334910567730151e-25)
  178.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (29) ((1 39))) -5.295682532331861e-26)
  179.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (30) ((1 39))) 1.2126341952959759e-26)
  180.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (31) ((1 39))) -2.801889708228943e-27)
  181.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (32) ((1 39))) 6.529267898701289e-28)
  182.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (33) ((1 39))) -1.5337980061873346e-28)
  183.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (34) ((1 39))) 3.6305884306364533e-29)
  184.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (35) ((1 39))) -8.656075571362912e-30)
  185.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (36) ((1 39))) 2.0779909972536278e-30)
  186.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (37) ((1 39))) -5.021117022141722e-31)
  187.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (38) ((1 39))) 1.2208360279441714e-31)
  188.   (f2cl-lib:fset (f2cl-lib:fref bt02cs (39) ((1 39))) -2.986005626703992e-32)
  189.   (setq first f2cl-lib:%true%)
  190.   (defun d9b0mp (x ampl theta)
  191.     (declare (type double-float theta ampl x))
  192.     (prog ((z 0.0) (eta 0.0f0))
  193.       (declare (type single-float eta) (type double-float z))
  194.       (cond
  195.        (first (setf eta (* 0.1f0 (f2cl-lib:freal (f2cl-lib:d1mach 3))))
  196.               (setf nbm0 (initds bm0cs 37 eta))
  197.               (setf nbt02 (initds bt02cs 39 eta))
  198.               (setf nbm02 (initds bm02cs 40 eta))
  199.               (setf nbth0 (initds bth0cs 44 eta))
  200.               (setf xmax (/ 1.0 (f2cl-lib:d1mach 4)))))
  201.       (setf first f2cl-lib:%false%)
  202.       (if (< x 4.0) (xermsg "SLATEC" "D9B0MP" "X MUST BE GE 4" 1 2))
  203.       (if (> x 8.0) (go label20))
  204.       (setf z (/ (- (/ 128.0 (* x x)) 5.0) 3.0))
  205.       (setf ampl (/ (+ 0.75 (dcsevl z bm0cs nbm0)) (f2cl-lib:fsqrt x)))
  206.       (setf theta (+ (- x pi4) (/ (dcsevl z bt02cs nbt02) x)))
  207.       (go end_label)
  208.      label20
  209.       (if (> x xmax)
  210.           (xermsg "SLATEC" "D9B0MP" "NO PRECISION BECAUSE X IS BIG" 2 2))
  211.       (setf z (- (/ 128.0 (* x x)) 1.0))
  212.       (setf ampl (/ (+ 0.75 (dcsevl z bm02cs nbm02)) (f2cl-lib:fsqrt x)))
  213.       (setf theta (+ (- x pi4) (/ (dcsevl z bth0cs nbth0) x)))
  214.       (go end_label)
  215.      end_label
  216.       (return (values nil ampl theta)))))
  217.  
  218.